home *** CD-ROM | disk | FTP | other *** search
/ infoROM 17,000 Product Descriptions for Business / infoROM Product Descriptions for Business - ESX Interactive.ISO / argdemos / nexsys / demo.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1993-06-21  |  8.9 KB  |  420 lines
  1. ; demo.lsp
  2. ; demo program for Overlay
  3. ;
  4. ; Derrick Oswald
  5. ; Nexsys Consulting Inc.
  6. ; 44 Douglas Drive
  7. ; Ayr, Ontario
  8. ; N0B 1E0
  9. ; (519) 632-8243
  10. ; (519) 632-8244 FAX
  11. ;
  12. (setvar "cmdecho" 1)
  13.  
  14. (setq delayconstant 1000.0)
  15.  
  16. (defun delaytime (x)
  17.   (* x delayconstant))
  18.  
  19. ; delay
  20. ; delay for n milliseconds
  21. (defun delay (n / start)
  22.   (setq start (getvar "date"))
  23.   (while start
  24.   (if (> (* 8.64e7 (- (getvar "date") start)) n)
  25.       (setq start ())))
  26.   (princ))
  27.  
  28. ; typein
  29. ; simulate user typing in
  30. (defun typein (s / l)
  31.   (setq i 1 l (strlen s))
  32.   (while (<= i l)
  33.     (delay (delaytime 0.3))
  34.     (princ (substr s i 1))
  35.     (setq i (1+ i)))
  36.   (delay (delaytime 0.6))
  37.   (princ))
  38.  
  39. ; backspace
  40. ; backup characters
  41. (defun backspace (n)
  42.   (while (> n 0)
  43.     (princ (chr 8))
  44.     (setq n (1- n)))
  45.   (princ))
  46.  
  47. ; submit
  48. ; simulate a command submission
  49. (defun submit (s)
  50.   (typein s)
  51.   (backspace (strlen s))
  52.   (command s)
  53.   (princ))
  54.  
  55. ; dragline
  56. ; draw a drag line
  57. (defun dragline (p1 p2 / x)
  58.   (setq x 0.0)
  59.   (while (< x 1.0)
  60.     (delay (delaytime 0.1))
  61.     (grdraw p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)) -1 0)
  62.     (setq x (min 1.0 (+ x 0.05))))
  63.   (princ))
  64.  
  65. ; drawbox
  66. ; draw a box in XOR ink
  67. (defun drawbox (p1 p2 / pa pb)
  68.   (setq pa (list (car p1) (cadr p2))
  69.         pb (list (car p2) (cadr p1)))
  70.   (grdraw p1 pa -1 0)
  71.   (grdraw pa p2 -1 0)
  72.   (grdraw p2 pb -1 0)
  73.   (grdraw pb p1 -1 0)
  74.   (princ))
  75.  
  76. ; explodingbox
  77. ; draw an exploding box
  78. (defun explodingbox (p1 p2 / x)
  79.   (setq x 0.0)
  80.   (while (< x 1.0)
  81.     (delay (delaytime 0.1))
  82.     (drawbox p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
  83.     (setq x (min 1.0 (+ x 0.05)))
  84.     (drawbox p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x))))
  85.   (delay (delaytime 1.0))
  86.   (drawbox p1 (polar p1 (angle p1 p2) (* (distance p1 p2) x)))
  87.   (princ))
  88.  
  89. ; zoomin
  90. ; simulate a zoom in
  91. (defun zoomin (p1 p2)
  92.   (submit "ZOOM")
  93.   (submit "W")
  94.   (delay (delaytime 1.0))
  95.   (command p1)
  96.   (explodingbox p1 p2)
  97.   (command p2)
  98.   (rredraw)
  99.   (princ))
  100.  
  101. ; docommand
  102. ; simulate command prompt
  103. (defun docommand ()
  104.   (princ "\nCommand: ")
  105.   (delay (delaytime 1)))
  106.  
  107. ; doredraw
  108. ; simulate redraw
  109. (defun doredraw ()
  110.   ; redraw
  111.   (typein "RREDRAW\n")
  112.   (redraw)
  113.   (rredraw)
  114.   (princ))
  115.  
  116. ; colour
  117. ; change the colour
  118. (defun colour (n)
  119.   (setvar "CMDECHO" 0)
  120.   (if n
  121.     (command "colour" n)
  122.     (command "colour" "BYLAYER"))
  123.   (setvar "CMDECHO" 1))
  124.  
  125. ; changelastcolour
  126. ; change last entities colour
  127. (defun changelastcolour (newcolour)
  128.   (submit "CHANGE")
  129.   (delay (delaytime 2))
  130.   (submit "L")
  131.   (delay (delaytime 2))
  132.   (command "")
  133.   (submit "P")
  134.   (submit "C")
  135.   (submit newcolour)
  136.   (delay (delaytime 1))
  137.   (command "")
  138.   (doredraw)
  139.   (docommand)
  140.   (princ))
  141.  
  142. ; doerase
  143. ; simulate an erase
  144. (defun doerase (entity)
  145.   (submit "ERASE")
  146.   (delay (delaytime 1))
  147.   (command entity)
  148.   (delay (delaytime 1))
  149.   (command "")
  150.   (doredraw)
  151.   (docommand)
  152.   (princ))
  153.  
  154. ; doovly
  155. ; simulate ovly command
  156. (defun doovly (filename x y r / ename)
  157.   (typein "ROVLY")
  158.   (princ "\nRaster filename: ")
  159.   (typein filename)
  160.   (princ (strcat "\nImage: (" (itoa x) "," (itoa y) ")\nOrigin <0,0>: "))
  161.   (typein "0,0")
  162.   (princ (strcat "\nScale/Opposite corner <"
  163.     (rtos (/ x r) 2 3)
  164.     ","
  165.     (rtos (/ y r) 2 3)
  166.     ">: "))
  167.   (delay (delaytime 1.5)) ; simulate RETURN
  168.   (princ "\nRotation angle <0>: ")
  169.   (delay (delaytime 1.5)) ; simulate RETURN
  170.   (princ "\n")
  171.  
  172.   (setq ename (rovly filename '(0 0) 0.0))
  173.   (docommand)
  174.   ename)
  175.  
  176. (defun c:demo ( / again )
  177.  
  178. ; uncomment this and at end of file for repeating demo
  179. ;  (setq again T)
  180. ;  (while again
  181.  
  182.     ; erase everything in the drawing
  183.     (setq ss (ssget "X" '()))
  184.     (if ss
  185.       (command "erase" ss ""))
  186.     (redraw)
  187.  
  188.     ; put up the first screen
  189.     (rtutorial "demo.txt" 0 (delaytime 7))
  190.  
  191.     ; put up the intro screen
  192.     (rtutorial "demo.txt" 1 (delaytime 18))
  193.  
  194.     ; pretend to key in the command
  195.     (setq image (doovly "LOT74.TIF" 3019 3551 200.0))
  196.  
  197.     ; explain about rredraw
  198.     (rtutorial "demo.txt" 2 (delaytime 27))
  199.  
  200.     ; zoom extents
  201.     (submit "ZOOM")
  202.     (submit "E")
  203.  
  204.     ; redraw
  205.     (typein "RREDRAW\n")
  206.     (rredraw)
  207.     (docommand)
  208.  
  209.     ; explain about COLOUR
  210.     (rtutorial "demo.txt" 3 (delaytime 21))
  211.  
  212.     (changelastcolour "BLUE")
  213.  
  214.     ; explain about RCLIP
  215.     (rtutorial "demo.txt" 4 (delaytime 27))
  216.  
  217.     (zoomin '(6.3 11.5) '(14.5 17.0))
  218.  
  219.     ; draw a polyline
  220.     (setq point1 (list 6.8 13.5 0.0))
  221.     (setq point2 (list 10.8 15.4 0.0))
  222.     ; these points are required later:
  223.     (setq point3 (list 9.75 14.75 0.0))
  224.  
  225.     ; create a polyline
  226.     (colour 3)
  227.     (submit "PLINE")
  228.     (delay (delaytime 1))
  229.     (command point1)
  230.     (delay (delaytime 1))
  231.     (command (list (car point1) (cadr point2)))
  232.     (delay (delaytime 1))
  233.     (command point2)
  234.     (delay (delaytime 1))
  235.     (command (list (car point2) (cadr point1)))
  236.     (delay (delaytime 1))
  237.     (command "close")
  238.     (colour ())
  239.  
  240.     ; clip out an area
  241.     (typein "RCLIP")
  242.     (princ "\nPolyline/<First corner>: ")
  243.     (typein "P")
  244.     (princ "\nSelect polyline: ")
  245.     (delay (delaytime 1))
  246.  
  247.     (setq pline (entlast))
  248.     (setq subimage (rclip image pline "subimage.tif"))
  249.     (docommand)
  250.  
  251.     (changelastcolour "MAGENTA")
  252.  
  253.     ; talk about multiple images and RERASE
  254.     (rtutorial "demo.txt" 5 (delaytime 23))
  255.  
  256.     ; move the sub-image
  257.     (submit "MOVE")
  258.     (delay (delaytime 1))
  259.     (submit "L")
  260.     (delay (delaytime 1))
  261.     (command "")
  262.     (delay (delaytime 1))
  263.     (command point1)
  264.     (dragline point1 point3)
  265.     (command point3)
  266.     (docommand)
  267.     (doredraw)
  268.     (docommand)
  269.  
  270.     ; erase an area
  271.     (typein "RERASE\n")
  272.     (princ "Select image: ")
  273.     (delay (delaytime 1))
  274.     (typein "\n")
  275.     (princ "Polyline/<First corner>: ")
  276.     (typein "P\n")
  277.     (princ "\nSelect polyline: ")
  278.     (delay (delaytime 1))
  279.     (rerase image pline)
  280.     (docommand)
  281.  
  282.     ; erase polyline
  283.     (doerase pline)
  284.  
  285.     ; talk about rcombine
  286.     (rtutorial "demo.txt" 6 (delaytime 25))
  287.  
  288.     ; combine images
  289.     (typein "RCOMBINE")
  290.     (princ "\nSelect target image: ")
  291.     (delay (delaytime 2))
  292.     (princ "\nSelect source image: ")
  293.     (rcombine image subimage)
  294.     (docommand)
  295.     (doredraw)
  296.     (docommand)
  297.  
  298.     ; erase the subimage
  299.     (doerase subimage)
  300.  
  301.     ; talk about rmerge
  302.     (rtutorial "demo.txt" 7 (delaytime 21))
  303.  
  304.     ; insert the entities
  305.     (submit "INSERT")
  306.     (submit "ENTITIES")
  307.     (delay (delaytime 1))
  308.     (command point1)
  309.     (submit "1")
  310.     (submit "1")
  311.     (submit "0")
  312.     (setq ss (ssadd (entlast)))
  313.  
  314.     ; merge the entities
  315.     (typein "RMERGE")
  316.     (princ "\nBrushwidth <1>: ")
  317.     (typein "4")
  318.     (princ "\nMake ends <Round>/Square: ")
  319.     (typein "ROUND\n")
  320.     (rmerge image 4 "ROUND" ss)
  321.     (docommand)
  322.  
  323.     ; erase the block
  324.     (setq ss (ssadd (entlast)))
  325.     (doerase ss)
  326.  
  327.     ; zoom extents
  328.     (submit "ZOOM")
  329.     (submit "E")
  330.     (rredraw)
  331.  
  332.     ; talk about save
  333.     (rtutorial "demo.txt" 8 (delaytime 25))
  334.  
  335.     ; save the image
  336.     (typein "RSAVE")
  337.     (princ "\nFile name? <C:\\OVLYDEMO\\LOT74.TIF>: ")
  338.     (typein "LOT74.MIL\n")
  339.     (rsave image "LOT74.MIL")
  340.     (docommand)
  341.  
  342.     ; erase the image
  343.     (doerase image)
  344.  
  345.     ; explain about rotation
  346.     (rtutorial "demo.txt" 9 (delaytime 25))
  347.  
  348.     ; insert the image
  349.     (setq image (doovly "3096.TIF" 1035 1016 200.0))
  350.     ; save it so the demo can be repeated
  351.     (rmode "quiet" 1)
  352.     (rsave image "30960000.TIF")
  353.     (rmode "quiet" 0)
  354.  
  355.     ; zoom extents
  356.     (submit "ZOOM")
  357.     (submit "E")
  358.     (rredraw)
  359.  
  360.     ; change to green
  361.     (changelastcolour "GREEN")
  362.  
  363.     ; rotate a few degrees
  364.     (submit "ROTATE")
  365.     (delay (delaytime 1))
  366.     (submit "L")
  367.     (delay (delaytime 1))
  368.     (command "")
  369.     (submit "0,0")
  370.     (submit "2.2373779")
  371.  
  372.     ; zoom extents
  373.     (submit "ZOOM")
  374.     (submit "E")
  375.     (rredraw)
  376.  
  377.     ; talk about rrectify
  378.     (rtutorial "demo.txt" 10 (delaytime 20))
  379.  
  380.     ; rectify the image
  381.     (typein "RRECTIFY\n")
  382.     (rrectify image)
  383.     (redraw)
  384.     (rredraw)
  385.     (docommand)
  386.  
  387.     ; talk about rvec
  388.     (rtutorial "demo.txt" 11 (delaytime 21))
  389.  
  390.     ; perform raster to vector conversion
  391.     (typein "RVEC")
  392.     (princ "\nConversion type Solid/Outline/<Centerline>: ")
  393.     (typein "CENTERLINE")
  394.     (princ "\nError tolerance <1>: ")
  395.     (typein "2.0\n")
  396.     (rvec image "CENTERLINE" 2.0)
  397.     (docommand)
  398.  
  399.     ; redraw
  400.     (rredraw)
  401.  
  402.     ; talk about rplot
  403.     (rtutorial "demo.txt" 12 (delaytime 17))
  404.  
  405.     ; summarize
  406.     (rtutorial "demo.txt" 13 (delaytime 17))
  407.  
  408. ; uncomment this and at top of function for repeating demo
  409. ;    (initget 0 "Yes No")
  410. ;    (setq again (getkword "Would you like to see the demo again? <N>: "))
  411. ;    (if (= again "No")
  412. ;      (setq again ())))
  413.  
  414.   ; print ending message
  415.   (princ "\nDemo finished.")
  416.   (docommand)
  417.  
  418.   (princ))
  419.  
  420.